home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 11 / Mac Magazin and MacEasy Magazine CD - Issue 11.iso / Sharewarebibliothek / Entwickler / WASTE 1.1b1 Distribution / WASTE Source / WEBirthDeath.p < prev    next >
Text File  |  1995-06-01  |  16KB  |  592 lines
  1. unit WEBirthDeath;
  2.  
  3. { WASTE PROJECT: }
  4. { Creation and Destruction, Standard Procs, etc. }
  5.  
  6. { Copyright © 1993-1995 Marco Piovanelli }
  7. { All Rights Reserved }
  8.  
  9. interface
  10.     uses
  11.         WEHighLevelEditing;
  12.  
  13.     function WENew (var destRect, viewRect: LongRect;
  14.                                     flags: Integer;
  15.                                     var hWE: WEHandle): OSErr;
  16.     procedure WEDispose (hWE: WEHandle);
  17.     function WEFeatureFlag (feature: Integer;
  18.                                     action: Integer;
  19.                                     hWE: WEHandle): Integer;
  20.     function WEGetInfo (selector: OSType;
  21.                                     info: Ptr;
  22.                                     hWE: WEHandle): OSErr;
  23.     function WESetInfo (selector: OSType;
  24.                                     info: Ptr;
  25.                                     hWE: WEHandle): OSErr;
  26.  
  27. implementation
  28.     uses
  29.         GestaltEqu, QDOffscreen, ToolUtils;
  30.  
  31.     var
  32.  
  33. { static variables }
  34.  
  35.         _weStdDrawTextProc: WEDrawTextUPP;
  36.         _weStdPixelToCharProc: WEPixelToCharUPP;
  37.         _weStdCharToPixelProc: WECharToPixelUPP;
  38.         _weStdLineBreakProc: WELineBreakUPP;
  39.         _weStdWordBreakProc: WEWordBreakUPP;
  40.         _weStdCharByteProc: WECharByteUPP;
  41.         _weStdCharTypeProc: WECharTypeUPP;
  42.  
  43.     procedure _WEStdDrawText (pText: Ptr;
  44.                                     textLength: LongInt;
  45.                                     slop: Fixed;
  46.                                     styleRunPosition: JustStyleCode;
  47.                                     hWE: WEHandle);
  48.     begin
  49.         DrawJustified(pText, textLength, slop, styleRunPosition, Point(kOneToOneScaling), Point(kOneToOneScaling));
  50.     end;  { _WEStdDrawText }
  51.  
  52.     function _WEStdPixelToChar (pText: Ptr;
  53.                                     textLength: LongInt;
  54.                                     slop: Fixed;
  55.                                     var width: Fixed;
  56.                                     var edge: SignedByte;
  57.                                     styleRunPosition: JustStyleCode;
  58.                                     hPos: Fixed;
  59.                                     hWE: WEHandle): LongInt;
  60.         var
  61.             tempPoint: Point;
  62.             lastWidth: Fixed;
  63.     begin
  64.         tempPoint := Point(kOneToOneScaling);
  65.         lastWidth := width;
  66.         _WEStdPixelToChar := PixelToChar(pText, textLength, slop, lastWidth, Boolean(edge), width, styleRunPosition, tempPoint, tempPoint);
  67.  
  68. { round width to nearest integer value }
  69. { (this is supposed to fix an incompatibility with the WorldScript Power Adapter) }
  70.         width := BSL(FixRound(width), 16);
  71.  
  72.     end;  { _WEStdPixelToChar }
  73.  
  74.     function _WEStdCharToPixel (pText: Ptr;
  75.                                     textLength: LongInt;
  76.                                     slop: Fixed;
  77.                                     offset: LongInt;
  78.                                     direction: Integer;
  79.                                     styleRunPosition: JustStyleCode;
  80.                                     hPos: LongInt;
  81.                                     hWE: WEHandle): Integer;
  82.     begin
  83.         _WEStdCharToPixel := CharToPixel(pText, textLength, slop, offset, direction, styleRunPosition, Point(kOneToOneScaling), Point(kOneToOneScaling));
  84.     end;  { _WEStdCharToPixel }
  85.  
  86.     function _WEStdLineBreak (pText: Ptr;
  87.                                     textLength: LongInt;
  88.                                     textStart, textEnd: LongInt;
  89.                                     var textWidth: Fixed;
  90.                                     var textOffset: LongInt;
  91.                                     hWE: WEHandle): StyledLineBreakCode;
  92.     begin
  93.         _WEStdLineBreak := StyledLineBreak(pText, textLength, textStart, textEnd, 0, textWidth, textOffset);
  94.     end;  { _WEStdLineBreak }
  95.  
  96.     procedure _WEStdWordBreak (pText: Ptr;
  97.                                     textLength: Integer;
  98.                                     offset: Integer;
  99.                                     edge: SignedByte;
  100.                                     var breakOffsets: OffsetTable;
  101.                                     script: ScriptCode;
  102.                                     hWE: WEHandle);
  103.     begin
  104.         FindWordBreaks(pText, textLength, offset, Boolean(edge), nil, breakOffsets, script);
  105.     end;  { _WEStdWordBreak }
  106.  
  107.     function _WEStdCharByte (pText: Ptr;
  108.                                     textOffset: Integer;
  109.                                     script: ScriptCode;
  110.                                     hWE: WEHandle): Integer;
  111.     begin
  112.         _WEStdCharByte := CharacterByteType(pText, textOffset, script);
  113.     end;  { _WEStdCharByte }
  114.  
  115.     function _WEStdCharType (pText: Ptr;
  116.                                     textOffset: Integer;
  117.                                     script: ScriptCode;
  118.                                     hWE: WEHandle): Integer;
  119.     begin
  120.         _WEStdCharType := CharacterType(pText, textOffset, script);
  121.     end;  { _WEStdCharType }
  122.  
  123.     function _WEScriptToFont (script: ScriptCode): Integer;
  124.     begin
  125.  
  126. { given an explicit script code, return the first font ID in the corresponding range }
  127. { for an explanation of the formula given below, see IM: Text, page B-8 }
  128.  
  129.         if (script = smRoman) then
  130.             _WEScriptToFont := 2
  131.         else if ((script > smRoman) and (script <= smUninterp)) then
  132.             _WEScriptToFont := $3E00 + $200 * script
  133.         else
  134.             _WEScriptToFont := systemFont;        { unknown script code (?) }
  135.  
  136.     end;  { _WEScriptToFont }
  137.  
  138. {$IFC UNDEFINED SystemSevenFiveOrLater}
  139.  
  140.     procedure _WEOldWordBreak (pText: Ptr;
  141.                                     textLength: Integer;
  142.                                     offset: Integer;
  143.                                     edge: SignedByte;
  144.                                     var breakOffsets: OffsetTable;
  145.                                     script: ScriptCode;
  146.                                     hWE: WEHandle);
  147.         var
  148.             savePort, tempPort: GrafPtr;
  149.             saveFont: Integer;
  150.     begin
  151.  
  152. { the old (now obsolete) FindWord routine gets an implicit script parameter through }
  153. { the current graphics port txFont field, so first of all we must have a valid port }
  154.         GetPort(savePort);
  155.         tempPort := hWE^^.port;
  156.         SetPort(tempPort);
  157.  
  158. { then set the txFont field to a font number in the specified script range }
  159.         saveFont := tempPort^.txFont;
  160.         TextFont(_WEScriptToFont(script));
  161.  
  162. { call _FindWord }
  163.         FindWord(pText, textLength, offset, Boolean(edge), nil, breakOffsets);
  164.  
  165. { restore font and port }
  166.         TextFont(saveFont);
  167.         SetPort(savePort);
  168.  
  169.     end;  { _WEOldWordBreak }
  170.  
  171.     function _WEOldCharByte (pText: Ptr;
  172.                                     textOffset: Integer;
  173.                                     script: ScriptCode;
  174.                                     hWE: WEHandle): Integer;
  175.         var
  176.             savePort, tempPort: GrafPtr;
  177.             saveFont: Integer;
  178.     begin
  179.  
  180. { the old (now obsolete) CharByte routine gets an implicit script parameter through }
  181. { the current graphics port txFont field, so first of all we must have a valid port }
  182.         GetPort(savePort);
  183.         tempPort := hWE^^.port;
  184.         SetPort(tempPort);
  185.  
  186. { then set the txFont field to a font number in the specified script range }
  187.         saveFont := tempPort^.txFont;
  188.         TextFont(_WEScriptToFont(script));
  189.  
  190. { call _CharByte }
  191.         _WEOldCharByte := CharByte(pText, textOffset);
  192.  
  193. { restore font and port }
  194.         TextFont(saveFont);
  195.         SetPort(savePort);
  196.  
  197.     end;  { _WEOldCharByte }
  198.  
  199.     function _WEOldCharType (pText: Ptr;
  200.                                     textOffset: Integer;
  201.                                     script: ScriptCode;
  202.                                     hWE: WEHandle): Integer;
  203.         var
  204.             savePort, tempPort: GrafPtr;
  205.             saveFont: Integer;
  206.     begin
  207.  
  208. { the old (now obsolete) CharType routine gets an implicit script parameter through }
  209. { the current graphics port txFont field, so first of all we must have a valid port }
  210.         GetPort(savePort);
  211.         tempPort := hWE^^.port;
  212.         SetPort(tempPort);
  213.  
  214. { then set the txFont field to a font number in the specified script range }
  215.         saveFont := tempPort^.txFont;
  216.         TextFont(_WEScriptToFont(script));
  217.  
  218. { call _CharType }
  219.         _WEOldCharType := CharType(pText, textOffset);
  220.  
  221. { restore font and port }
  222.         TextFont(saveFont);
  223.         SetPort(savePort);
  224.  
  225.     end;  { _WEOldCharType }
  226.  
  227. {$ENDC}
  228.  
  229.     function _WERegisterWithTSM (hWE: WEHandle): OSErr;
  230.  
  231. { the WE record must be already locked }
  232.  
  233.         label
  234.             1;
  235.         var
  236.             pWE: WEPtr;
  237.             typeList: InterfaceTypeList;
  238.             err: OSErr;
  239.     begin
  240.         pWE := hWE^;
  241.  
  242. { do nothing if the Text Services Manager isn't available }
  243.         if BTST(pWE^.flags, weFHasTextServices) then
  244.             begin
  245.                 typeList[0] := kTextService;
  246.                 err := NewTSMDocument(1, typeList, pWE^.tsmReference, LongInt(hWE));
  247.                 if (err <> noErr) then
  248.  
  249. { we don't consider it an error if our client application isn't TSM-aware }
  250.                     if (err <> tsmNeverRegisteredErr) then
  251.                         goto 1;
  252.             end;
  253.  
  254. { clear result code }
  255.         err := noErr;
  256.  
  257. 1:
  258. { return result code }
  259.         _WERegisterWithTSM := err;
  260.  
  261.     end;  { _WERegisterWithTSM }
  262.  
  263.     procedure _WESetStandardHooks (hWE: WEHandle);
  264.         var
  265.             pWE: WEPtr;
  266.     begin
  267.  
  268. { the first time we're called, create routine descriptors }
  269.         if (_weStdDrawTextProc = nil) then
  270.             begin
  271.                 _weStdDrawTextProc := NewWEDrawTextProc(@_WEStdDrawText);
  272.                 _weStdPixelToCharProc := NewWEPixelToCharProc(@_WEStdPixelToChar);
  273.                 _weStdCharToPixelProc := NewWECharToPixelProc(@_WEStdCharToPixel);
  274.                 _weStdLineBreakProc := NewWELineBreakProc(@_WEStdLineBreak);
  275.  
  276. {$IFC UNDEFINED SystemSevenFiveOrLater}
  277.  
  278.                 if (GetScriptManagerVariable(smVersion) < $710) then
  279.                     begin
  280.  
  281. { pre-7.1 version of the Script Manager: must use old hooks }
  282.                         _weStdWordBreakProc := NewWEWordBreakProc(@_WEOldWordBreak);
  283.                         _weStdCharByteProc := NewWECharByteProc(@_WEOldCharByte);
  284.                         _weStdCharTypeProc := NewWECharTypeProc(@_WEOldCharType);
  285.  
  286.                     end
  287.                 else
  288.  
  289. {$ENDC}
  290.  
  291.                     begin
  292.  
  293. { Script Manager version 7.1 or newer }
  294.                         _weStdWordBreakProc := NewWEWordBreakProc(@_WEStdWordBreak);
  295.                         _weStdCharByteProc := NewWECharByteProc(@_WEStdCharByte);
  296.                         _weStdCharTypeProc := NewWECharTypeProc(@_WEStdCharType);
  297.                     end;
  298.             end;  { if called for the first time }
  299.  
  300. { replace null hook fields with the addresses of the standard hooks }
  301.  
  302.         pWE := hWE^;
  303.  
  304.         if (pWE^.drawTextHook = nil) then
  305.             pWE^.drawTextHook := _weStdDrawTextProc;
  306.  
  307.         if (pWE^.pixelToCharHook = nil) then
  308.             pWE^.pixelToCharHook := _weStdPixelToCharProc;
  309.  
  310.         if (pWE^.charToPixelHook = nil) then
  311.             pWE^.charToPixelHook := _weStdCharToPixelProc;
  312.  
  313.         if (pWE^.lineBreakHook = nil) then
  314.             pWE^.lineBreakHook := _weStdLineBreakProc;
  315.  
  316.         if (pWE^.wordBreakHook = nil) then
  317.             pWE^.wordBreakHook := _weStdWordBreakProc;
  318.  
  319.         if (pWE^.charByteHook = nil) then
  320.             pWE^.charByteHook := _weStdCharByteProc;
  321.  
  322.         if (pWE^.charTypeHook = nil) then
  323.             pWE^.charTypeHook := _weStdCharTypeProc;
  324.  
  325.     end;  { _WESetStandardHooks }
  326.  
  327.     function WENew (var destRect, viewRect: LongRect;
  328.                                     flags: Integer;
  329.                                     var hWE: WEHandle): OSErr;
  330.         label
  331.             1, 2;
  332.         var
  333.             pWE: WEPtr;
  334.             allocFlags: Integer;
  335.             weFlags: LongInt;
  336.             response: LongInt;
  337.             r: Rect;
  338.             err: OSErr;
  339.     begin
  340.         pWE := nil;
  341.         weFlags := flags;
  342.         allocFlags := kAllocClear;
  343.  
  344. { allocate the WE record }
  345.         err := _WEAllocate(SizeOf(WERec), allocFlags, hWE);
  346.         if (err <> noErr) then
  347.             goto 1;
  348.  
  349. { lock it down }
  350.         HLock(Handle(hWE));
  351.         pWE := hWE^;
  352.  
  353. { get active port }
  354.         GetPort(pWE^.port);
  355.  
  356. { determine whether temporary memory should be used for data structures }
  357.         if BTST(weFlags, weFUseTempMem) then
  358.             allocFlags := allocFlags + kAllocTemp;
  359.  
  360. { allocate the text handle (initially empty) }
  361.         err := _WEAllocate(0, allocFlags, pWE^.hText);
  362.         if (err <> noErr) then
  363.             goto 1;
  364.  
  365. { allocate the line array }
  366.         err := _WEAllocate(2 * SizeOf(LineRec), allocFlags, pWE^.hLines);
  367.         if (err <> noErr) then
  368.             goto 1;
  369.  
  370. { allocate the style table }
  371.         err := _WEAllocate(SizeOf(StyleTableElement), allocFlags, pWE^.hStyles);
  372.         if (err <> noErr) then
  373.             goto 1;
  374.  
  375. { allocate the run array }
  376.         err := _WEAllocate(2 * SizeOf(RunArrayElement), allocFlags, pWE^.hRuns);
  377.         if (err <> noErr) then
  378.             goto 1;
  379.  
  380. { check for the presence of various system software features }
  381. { determine whether Color QuickDraw is available }
  382.         if (Gestalt(gestaltQuickDrawVersion, response) = noErr) then
  383.             if (response >= gestalt8BitQD) then
  384.                 BSET(weFlags, weFHasColorQD);
  385.  
  386. { determine whether the Text Services manager is available }
  387.         if (Gestalt(gestaltTSMgrVersion, response) = noErr) then
  388.             BSET(weFlags, weFHasTextServices);
  389.  
  390. { determine if there are any non-Roman scripts enabled }
  391.         if (GetScriptManagerVariable(smEnabled) > 1) then
  392.             BSET(weFlags, weFNonRoman);
  393.  
  394. { determine whether a double-byte script is installed }
  395.         if (GetScriptManagerVariable(smDoubleByte) <> 0) then
  396.             BSET(weFlags, weFDoubleByte);
  397.  
  398. { determine whether the Drag Manager is available }
  399.         if (Gestalt(gestaltDragMgrAttr, response) = noErr) then
  400.             if BTST(response, gestaltDragMgrPresent) then
  401.                 BSET(weFlags, weFHasDragManager);
  402.  
  403. { initialize miscellaneous fields of the WE record }
  404.         pWE^.nLines := 1;
  405.         pWE^.nStyles := 1;
  406.         pWE^.nRuns := 1;
  407.         pWE^.viewRect := viewRect;
  408.         pWE^.destRect := destRect;
  409.         pWE^.flags := weFlags;
  410.         pWE^.tsmAreaStart := kInvalidOffset;
  411.         pWE^.tsmAreaEnd := kInvalidOffset;
  412.         pWE^.dragCaretOffset := kInvalidOffset;
  413.  
  414. { initialize hook fields with the addresses of the standard hooks }
  415.         _WESetStandardHooks(hWE);
  416.  
  417. { create a region to hold the view rectangle }
  418.         pWE^.viewRgn := NewRgn;
  419.         WELongRectToRect(viewRect, r);
  420.         RectRgn(pWE^.viewRgn, r);
  421.  
  422. { initialize the style run array }
  423.         with pWE^.hRuns^^[1] do
  424.             begin
  425.                 runStart := 1;
  426.                 styleIndex := -1;
  427.             end;
  428.  
  429. { initialize the style table }
  430.         with pWE^.hStyles^^[0] do
  431.             begin
  432.                 refCount := 1;
  433.  
  434. { copy text attributes from the active graphics port }
  435.                 info.runStyle.tsFont := pWE^.port^.txFont;
  436.                 info.runStyle.tsSize := pWE^.port^.txSize;
  437.                 info.runStyle.tsFace := GrafPtr1(pWE^.port)^.txFace;
  438.                 if BTST(weFlags, weFHasColorQD) then
  439.                     GetForeColor(info.runStyle.tsColor);
  440.                 _WEFillFontInfo(pWE^.port, info);
  441.  
  442.             end;
  443.  
  444. { initialize the line array }
  445.         err := WECalText(hWE);
  446.         if (err <> noErr) then
  447.             goto 1;
  448.  
  449. { register with the Text Services Manager }
  450.         err := _WERegisterWithTSM(hWE);
  451.         if (err <> noErr) then
  452.             goto 1;
  453.  
  454. { unlock the WE record }
  455.         HUnlock(Handle(hWE));
  456.  
  457. { clear result code }
  458.         err := noErr;
  459.  
  460. { skip clean-up section }
  461.         goto 2;
  462.  
  463. 1:
  464. { clean up }
  465.         if (pWE <> nil) then
  466.             begin
  467.                 _WEForgetHandle(pWE^.hText);
  468.                 _WEForgetHandle(pWE^.hLines);
  469.                 _WEForgetHandle(pWE^.hStyles);
  470.                 _WEForgetHandle(pWE^.hRuns);
  471.                 if (pWE^.viewRgn <> nil) then
  472.                     DisposeRgn(pWE^.viewRgn);
  473.             end;
  474.         _WEForgetHandle(hWE);
  475.  
  476. 2:
  477. { return result code }
  478.         WENew := err;
  479.  
  480.     end;  { WENew }
  481.  
  482.     procedure WEDispose (hWE: WEHandle);
  483.         var
  484.             pWE: WEPtr;
  485.             pTable: StyleTablePtr;
  486.             index: LongInt;
  487.     begin
  488.  
  489. { sanity check: make sure WE isn't NIL }
  490.         if (hWE = nil) then
  491.             Exit(WEDispose);
  492.  
  493. { lock the WE record }
  494.         HLock(Handle(hWE));
  495.         pWE := hWE^;
  496.  
  497. { clear the Undo buffer }
  498.         WEClearUndo(hWE);
  499.  
  500. { unregister with the Text Services Manager }
  501.         if (pWE^.tsmReference <> nil) then
  502.             begin
  503.                 if (DeleteTSMDocument(pWE^.tsmReference) <> noErr) then
  504.                     ;
  505.                 pWE^.tsmReference := nil;
  506.             end;
  507.  
  508. { dispose of the offscreen graphics world }
  509.         if (pWE^.offscreenPort <> nil) then
  510.             begin
  511.                 DisposeGWorld(GWorldPtr(pWE^.offscreenPort));
  512.                 pWE^.offscreenPort := nil;
  513.             end;
  514.  
  515.         if (pWE^.hStyles <> nil) then
  516.             begin
  517.  
  518. { lock the style table }
  519.                 HLock(Handle(pWE^.hStyles));
  520.                 pTable := pWE^.hStyles^;
  521.  
  522. { walk the style table, disposing of all embedded objects referenced there }
  523.                 index := 0;
  524.                 while (index < pWE^.nStyles) do
  525.                     with pTable^[index] do
  526.                         begin
  527.                             if (refCount > 0) then
  528.                                 if (_WEFreeObject(WEObjectDescHandle(info.runStyle.tsObject)) <> noErr) then
  529.                                     ;        { don't known what to do with errors }
  530.                             index := index + 1;
  531.                         end;
  532.             end;
  533.  
  534. { dispose of auxiliary data structures }
  535.         _WEForgetHandle(pWE^.hText);
  536.         _WEForgetHandle(pWE^.hLines);
  537.         _WEForgetHandle(pWE^.hStyles);
  538.         _WEForgetHandle(pWE^.hRuns);
  539.         _WEForgetHandle(pWE^.hObjectHandlerTable);
  540.         DisposeRgn(pWE^.viewRgn);
  541.  
  542. { dispose of the WE record }
  543.         DisposeHandle(Handle(hWE));
  544.  
  545.     end;  { WEDispose }
  546.  
  547.     function WEFeatureFlag (feature: Integer;
  548.                                     action: Integer;
  549.                                     hWE: WEHandle): Integer;
  550.         var
  551.             flag: Integer;
  552.             pWE: WEPtr;
  553.     begin
  554.         pWE := hWE^;
  555.  
  556. { get current status of the specified flag }
  557.         flag := Integer(BTST(pWE^.flags, feature));
  558.  
  559. { if action is weBitToggle, invert flag }
  560.         if (action = weBitToggle) then
  561.             action := 1 - flag;
  562.  
  563. { reset flag according to action }
  564.         if (action = weBitClear) then
  565.             BCLR(pWE^.flags, feature)
  566.         else if (action = weBitSet) then
  567.             BSET(pWE^.flags, feature);
  568.  
  569. { return old status }
  570.         WEFeatureFlag := flag;
  571.  
  572.     end;  { WEFeatureFlag }
  573.  
  574.     function WEGetInfo (selector: OSType;
  575.                                     info: Ptr;
  576.                                     hWE: WEHandle): OSErr;
  577.     begin
  578.         WEGetInfo := _WEGetField(_WEMainSelectorTable, selector, info, hWE^);
  579.     end;  { WEGetInfo }
  580.  
  581.     function WESetInfo (selector: OSType;
  582.                                     info: Ptr;
  583.                                     hWE: WEHandle): OSErr;
  584.     begin
  585.         WESetInfo := _WESetField(_WEMainSelectorTable, selector, info, hWE^);
  586.  
  587. { the hook fields can never be NIL, so replace any NIL field with the default address }
  588.         _WESetStandardHooks(hWE);
  589.  
  590.     end;  { WESetInfo }
  591.  
  592. end.